home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 20
/
Cream of the Crop 20 (Terry Blount) (1996).iso
/
program
/
cluster2.zip
/
SOURCE.ZIP
/
VERTMENU.BU
< prev
Wrap
Text File
|
1996-07-06
|
15KB
|
341 lines
$COMPILE UNIT ".\VERTMENU.PBU"
$CODE SEG "SCRNLIB"
$CPU 8086 ' Make compatible with XT systems
$LIB ALL OFF ' Turn off all PowerBASIC libraries
$ERROR ALL OFF ' Turn off all PowerBASIC error checking
$OPTIMIZE SIZE ' Optimize for smaller code
DEFINT A-Z ' Required for all numeric functions, forces PB to not
' include floating point in UNIT (makes it smaller)
'+-----------------------------------------------------------------+
'| This component of PB3BOXES is Copyright Nathan C. Durland III |
'| All rights reserved |
'+-----------------------------------------------------------------+
$INCLUDE ".\PB3BOXES.HDR"
SUB VerticalMenu(MenuList$(), Choice%, BYVAL DisplayMode%, _
BYVAL HighAttr%, BYVAL MenuTimer%, _
BYVAL ProcTimer%, BYVAL ProcAddr AS DWORD) LOCAL PUBLIC
'╒════════════════════════════════════════════════════════════════════════════╕
'│ This is the routine to call for simple one-choice vertical menus │
'│ │
'│ See TagMenu for a more complete definition of the paramters │
'╘════════════════════════════════════════════════════════════════════════════╛
Junk$ = "ONE"
CALL TagMenu(MenuList$(), Junk$, DisplayMode%, _
HighAttr%,MenuTimer%, ProcTimer%, ProcAddr)
Choice% = INSTR(junk$,"1")
END SUB
SUB TagMenu(MenuList$(), TagList$, BYVAL DisplayMode%, _
BYVAL HighAttr%, BYVAL MenuTimeOut%, _
BYVAL ProcTimeOut%, BYVAL ProcAddr AS DWORD) PUBLIC
'╒════════════════════════════════════════════════════════════════════════════╕
'│ This routine will display a list of items -- MenuList$() -- on the screen │
'│ and will toggle the corresponding element of TagMenuChoice%() from %True │
'│ to %False, as appropriate. Each tagged entry will have a "" next to it. │
'│ │
'│ The user can toggle the choice of an item by pressing the INS or the │
'│ DEL key. CTRL-INS & CTRL-DEL will select/deselect all items. │
'│ │
'│ The ENTER key will terminate the call. ESC also terminates, but will set │
'│ the ItemsTagged% parameter to 0. │
'│ │
'│ - The Home Key will move the menu to the top, │
'│ - The End key will proceed to the bottom. │
'╞════════════════════════════════════════════════════════════════════════════╡
'│Using TagMenu really involves 3 CALL statements: │
'│ 1. call MakeBox to create a box to place the menu in. Make sure the │
'│ box is at least 4 characters wider than the widest menu list item. │
'│ 2. call TagMenu. │
'│ 3. call RemoveBox. │
'╞════════════════════════════════════════════════════════════════════════════╡
'│PowerBASIC calling parameters: │
'│ │
'│ MenuList$() -- the items to display on the screen. The last element in │
'│ the array must be set to "" │
'│ TagList$ -- A string of "0" and "1", with a lenght equal to the │
'│ number of items in the menu. "1" corresponds to a │
'│ tagged item. If this string is eqal to "ONE" when this │
'│ routine is called, then the user will only be allowed │
'│ to make one choice. │
'│ DisplayMode% -- if 0, then the choices are centered in the box. │
'│ -- if 1, the choices are left justified │
'│ -- if 2, the choices are left justified, and have a │
'│ letter next to them. Pressing the letter highlights │
'│ that choice. The letters are based on the items position│
'│ in the menu screen │
'│ HighAttr% -- The color attribute to use for highlighted items │
'│ MenuTimeOut% -- a timeout value (seconds). If no choice is made before │
'│ this runs out, the menu exits and returns Choice% = 0. │
'│ Set MenuTimer% to 0 for no time out. A message is │
'│ displayed on the bottom of the screen. │
'│ ProcTimeOut% -- Another timer. This counts how long before the routine │
'│ pointed to by ProcAddr should be called. Set it to 0 │
'│ for no timed routine. Handy for print spoolers, etc │
'│ ProcAddr -- A DWORD value returned by CODEPTR32 that points to a │
'│ routine that you'd like done every ProcTimeOut% seconds │
'╘════════════════════════════════════════════════════════════════════════════╛
JustOne% = (TagList$ = "ONE")
MenuRow% = BoxParms%(CurrentBox%,1) ' Get current box size & paramters
MenuCol% = BoxParms%(CurrentBox%,2)
MenuRows% = BoxParms%(CurrentBox%,3)
MenuCols% = BoxParms%(CurrentBox%,4)
MenuAttr% = BoxParms%(CurrentBox%,5)
'╒════════════════════════════════════════════════════════════════╕
'│ We're might have to change these, so we want to save them now │
'╘════════════════════════════════════════════════════════════════╛
OldMenuCol% = MenuCol%
OldMenuRows% = MenuRows%
OldMenuCols% = MenuCols%
IF BoxParms%(CurrentBox%,6) > 0 THEN ' Account for the border
INCR MenuRow%,1
DECR MenuRows%,2
INCR MenuCol%,1
DECR MenuCols%,2
END IF
MenuLen% = MenuRows% ' set some other vars that we need
ARRAY SCAN MenuList$(1), = "", TO ItemCnt%
IF ItemCnt% = 0 THEN
ItemCnt% = UBOUND(MenuList$())
ELSE
DECR ItemCnt%,1
END IF
IF ItemCnt% < MenuLen% THEN
MenuLen% = ItemCnt%
MenuRows% = ItemCnt%
BoxParams%(CurrentBox%,3) = ItemCnt% + 2 ' set this so that only the area
END IF ' with menu items on it scrolls
IF DisplayMode% = 2 THEN ' put the letters in place for
FOR x% = 1 TO MenuLen% ' the menu
CALL PrtBox(x%,1,CHR$(64+x%,32),HighAttr%)
NEXT x%
BoxParms%(CurrentBox%,2) = MenuCol% + 1
BoxParms%(CurrentBox%,4) = MenuCol% - 1 ' change this so letters don't
MenuCol% = MenuCol% + 2 ' scroll with box
MenuCols% = MenuCols% - 2
END IF
TagList$ = TagList$ + STRING$(ItemCnt%,"0")
TagList$ = LEFT$(TagList$,ItemCnt%)
ItemPtr% = 1 'Array member currently pointed to
curntpos% = 1 'Position in the on-screen menu
TheCnt% = ItemsTagged%
TopItem% = 1
BottomItem% = MenuLen%
GOSUB FillTagMenu
MenuTimer! = -1
ProcTimer! = -1
IF MenuTimeOut% > 0 THEN MenuTimer! = TIMER + MenuTimeOut%
IF ProcTimeOut% > 0 THEN ProcTimer! = TIMER + ProcTimeOut%
Terminated% = %False
WHILE NOT Terminated%
' Highlight the current item
CALL QATTR((MenuRow%+curntPos%-1), MenuCol%,1, MenuCols%, HighAttr%)
' Get a keypress from the user, and do other stuff while we are waiting
WHILE NOT INSTAT
IF (MenuTimer! > 0) AND (TIMER > MenuTimer!) THEN
TagList$ = STRING$(ItemCnt%,"0")
EXIT SUB
END IF
IF (ProcTimer! > 0) AND (TIMER > ProcTimer!) THEN
CALL DWORD ProcAddr
ProcTimer! = TIMER + ProcTimeOut%
END IF
WEND
a$ = INKEY$ ' get the key, then
IF LEN(a$) = 1 THEN ' assign the ascii value to
ans% = ASC(UCASE$(a$)) ' our response.
ELSE ' for two byte keys, re